home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / msdos / 4utils80.zip / SCANZIPF.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-17  |  9KB  |  274 lines
  1. UNIT ScanZIPFiles;
  2. {$D-,V-}
  3. (* ----------------------------------------------------------------------
  4.    Part of 4DESC - A Simple 4DOS File Description Editor
  5.        and 4FF   - 4DOS File Finder
  6.  
  7.    (c) 1992, 1993 Copyright by David Frey,
  8.                                Urdorferstrasse 30
  9.                                8952 Schlieren ZH
  10.                                Switzerland
  11.  
  12.    DISCLAIMER: This unit is freeware: you are allowed to use, copy
  13.                and change it free of charge, but you may not sell or hire
  14.                this part of 4DESC. The copyright remains in our hands.
  15.  
  16.                If you make any (considerable) changes to the source code,
  17.                please let us know. (send a copy or a listing).
  18.                We would like to see what you have done.
  19.  
  20.                We, David Frey and Tom Bowden, the authors, provide absolutely
  21.                no warranty of any kind. The user of this software takes the
  22.                entire risk of damages, failures, data losses or other
  23.                incidents.
  24.  
  25.  
  26.        Code created using Turbo Pascal 6.0 (c) Borland International 1990
  27.  
  28.    This unit provides the extraction of file names in .ZIP files.
  29.  
  30.    ----------------------------------------------------------------------- *)
  31.  
  32. INTERFACE USES Dos, Globals;
  33.  
  34. PROCEDURE SearchInZIPFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  35.                           VAR Dir: PathStr; VAR zipsearch: SearchRec);
  36. PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
  37.                               csize: LONGINT);
  38. (* PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
  39.                               csize: LONGINT;desc: DescStr); *)
  40.  
  41. VAR OldZIPFileName: PathStr;
  42.  
  43. IMPLEMENTATION USES Objects, Drivers, StringDateHandling;
  44.  
  45. VAR ZIPFile       : FILE;
  46.  
  47. PROCEDURE SearchInZIPFile(FileSpec: FileSpecArrayType; FileSpecs: BYTE;
  48.                           VAR Dir: PathStr; VAR zipsearch: SearchRec);
  49.  
  50. CONST StartOfCentralDir = $02014b50;
  51.       StartOfLocalHeader= $04034b50;
  52.       EndOfCentralDir   = $06054b50;
  53.  
  54. VAR i,l,cl,el  : WORD;
  55.     k,Dummy    : BYTE;
  56.     ZIPFileName: NameExtStr;
  57.     sig        : LONGINT;
  58.     Desc       : DescStr;
  59.  
  60. BEGIN (* SearchInZIPFile *)
  61.  Assign(ZIPFile,zipsearch.Name); Reset(ZIPFile,1);
  62.  
  63.  BlockRead(ZIPFile,Buffer^,BufSize,BytesRead);
  64.  BufPtr := 0; FilePtr := 0;
  65.  
  66. (* REPEAT
  67.   sig := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16+
  68.          LONGINT(ReadByte) SHL  8 + ReadByte;
  69.   IF BufPtr > BufSize THEN
  70.    BEGIN
  71.     BlockRead(ZIPFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  72.    END;
  73.  UNTIL (sig = StartOfCentralDir) OR
  74.        (sig = EndOfCentralDir) OR (BufPtr > BytesRead); *)
  75.  
  76.  REPEAT
  77.   REPEAT
  78.    sig := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16+
  79.           LONGINT(ReadByte) SHL  8 + ReadByte;
  80.    IF BufPtr > BufSize THEN
  81.     BEGIN
  82.      BlockRead(ZIPFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  83.     END;
  84.   UNTIL (sig = StartOfLocalHeader (* StartOfCentralDir *) ) OR
  85.         (sig = StartOfCentralDir  (* EndOfCentralDir *) )   OR
  86.         (BufPtr > BytesRead);
  87.  
  88.   IF BufPtr > BytesRead THEN
  89.    BEGIN
  90.     WriteLn(output,'ZIP file error: local file header signature missing!');
  91.     WriteLn(output);
  92.    END;
  93.  
  94.   IF sig = StartOfLocalHeader (* StartCentralDir *) THEN
  95.    BEGIN
  96.     FOR i := 1 TO 6 DO dummy := ReadByte;
  97.     (* version needed to extract    2 bytes
  98.        version made by            2 bytes // not on local file header
  99.        general purpose bit flag            2 bytes
  100.        compression method        2 bytes *)
  101.  
  102.     Search.time := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  103.     (* last mod file time               2 bytes,
  104.        last mod file date               2 bytes *)
  105.  
  106.     FOR i := 1 TO 4 DO dummy := ReadByte;
  107.     (* crc-32               4 bytes *)
  108.  
  109.     csize       := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  110.     (* compressed size                4 bytes *)
  111.  
  112.     Search.size := LONGINT(ReadByte) SHL 24 + LONGINT(ReadByte) SHL 16 + LONGINT(ReadByte) SHL 8 + ReadByte;
  113.     (* uncompressed size        4 bytes *)
  114.  
  115.     l := ReadByte SHL 8+ReadByte;
  116.     (* filename length                2 bytes *)
  117.  
  118.     el:= ReadByte SHL 8+ReadByte;
  119.     (* extra field length        2 bytes *)
  120.  
  121. (*  cl:= ReadByte SHL 8+ReadByte; *)
  122.     (* file comment length        2 bytes *)
  123.  
  124. (*  FOR i := 1 TO 4 DO dummy := ReadByte; *)
  125.     (* disk number start        2 bytes
  126.        interrnal file attributes    2 bytes *)
  127.  
  128. (*  Search.Attr := ReadByte; *)
  129.     (* external file attributes            4 bytes , first byte *)
  130.  
  131. (*  FOR i := 1 TO 7 DO dummy := ReadByte; *)
  132.     (* relative offset of local header    4 bytes *)
  133.  
  134.     WITH Search DO
  135.      BEGIN
  136.       name := '';
  137.       FOR i := 1 TO l DO
  138.        IF i <= 12 THEN name := name+DownCase(Chr(ReadByte))
  139.                   ELSE dummy:= ReadByte;
  140.      END;
  141.     (* filename (variable size) *)
  142.  
  143.     FOR i := 1 TO el DO dummy := ReadByte;
  144.     (* extra field (variable size) *)
  145.  
  146. (*    Desc := '';
  147.     FOR i := 1 TO cl DO Desc := Desc + Chr(ReadByte); *)
  148.     (* file comment (variable size) *)
  149.  
  150.     FOR k := 1 TO FileSpecs DO
  151.      BEGIN
  152.       FSplit(FileSpec[k],Path,name,ext);
  153.       WHILE Length(name) < 8 DO name := name+' ';
  154.       IF Ext = '' THEN Ext := '.   '
  155.       ELSE
  156.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  157.  
  158.       i := Pos('*',name);
  159.       IF  i > 0 THEN
  160.        WHILE i <= 8 DO
  161.         BEGIN
  162.          name[i] := '?'; INC(i);
  163.         END;
  164.  
  165.       i := Pos('*',ext);
  166.       IF  i > 0 THEN
  167.        WHILE i <= 4 DO
  168.         BEGIN
  169.          ext[i] := '?'; INC(i);
  170.         END;
  171.       FileSpec[k] := Path+name+ext;
  172.  
  173.       FSplit(Search.Name,Path,name,ext);
  174.       WHILE Length(name) < 8 DO name := name +' ';
  175.       IF Ext = '' THEN Ext := '.   '
  176.       ELSE
  177.        WHILE Length(ext)      < 4 DO ext := ext+' ';
  178.       ZIPFileName:= Path+name+ext;
  179.  
  180.       i := 1;
  181.       WHILE ((FileSpec[k][i] = '?') OR (FileSpec[k][i] = ZIPFileName[i])) AND
  182.              (i<12) DO
  183.        INC(i);
  184.  
  185.       IF ((ExactAttr AND (Search.Attr = Attr)) OR (NOT ExactAttr)) AND
  186.           (FileSpec[k][i] = '?') OR (FileSpec[k][i] = ZIPFileName[i]) THEN
  187.        ShowCompZIPFileData(search,zipsearch,Dir,csize);
  188. (*       ShowCompZIPFileData(search,zipsearch,Dir,csize,Desc); *)
  189.      END;
  190.  
  191.     INC(BufPtr,csize); INC(FilePtr,csize);
  192.     Seek(ZIPFile,FilePtr);
  193.     IF BufPtr > BufSize THEN
  194.      BEGIN
  195.       BlockRead(ZIPFile,Buffer^,BufSize,BytesRead); BufPtr := 0;
  196.      END;
  197.    END;
  198.  UNTIL (BufPtr > BytesRead) OR (sig = StartOfCentralDir);
  199.  
  200.  Close(ZIPFile);
  201. END; (* SearchInZIPFile *)
  202.  
  203. (* PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
  204.                               csize: LONGINT;desc: DescStr); *)
  205. PROCEDURE ShowCompZIPFileData(VAR search,zipsearch: SearchRec;VAR Path: PathStr;
  206.                               csize: LONGINT);
  207.  
  208. VAR i       : INTEGER;
  209.  
  210. BEGIN
  211.  IF BareOutput THEN
  212.   Write(Output,Path,zipsearch.Name,' ')
  213.  ELSE
  214.   BEGIN
  215.    IF FileCount = 0 THEN
  216.     BEGIN
  217.      WriteLn(Output); IF DoPage THEN TestForMoreMsg;
  218.      WriteLn(Output,Path); IF DoPage THEN TestForMoreMsg;
  219.     END;
  220.  
  221.    IF zipsearch.Name <> OldZIPFileName THEN
  222.     BEGIN
  223.      DownString(zipsearch.Name); OldZIPFileName := zipsearch.Name;
  224.  
  225.      InfoArray[0] := LONGINT(@zipsearch.Name);
  226.  
  227.      SizeStr := FormattedLongIntStr(zipsearch.Size,8);
  228.      InfoArray[1] := LONGINT(@SizeStr);
  229.  
  230.      UnpackTime(zipsearch.Time,DateRec);
  231.      Date := FormDate(DateRec); Time := FormTime(DateRec);
  232.      InfoArray[2] := LONGINT(@Date);
  233.      InfoArray[3] := LONGINT(@Time);
  234.  
  235.      AttrStr := '....';
  236.      IF zipsearch.Attr AND ReadOnly = ReadOnly THEN AttrStr[1] := 'r';
  237.      IF zipsearch.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  238.      IF zipsearch.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  239.      IF zipsearch.Attr AND Archive  = Archive  THEN AttrStr[4] := 'a';
  240.      InfoArray[4] := LONGINT(@AttrStr);
  241.  
  242.      FormatStr(s,'(%-12s   %8s '+DateTempl+' '+TimeTempl+' %4s)',InfoArray);
  243.      WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  244.     END;
  245.  
  246.    InfoArray[0] := LONGINT(@search.Name);
  247.  
  248.    SizeStr := FormattedLongIntStr(search.Size,8);
  249.    InfoArray[1] := LONGINT(@SizeStr);
  250.  
  251.    UnpackTime(search.Time,DateRec);
  252.    Date := FormDate(DateRec); Time := FormTime(DateRec);
  253.    InfoArray[2] := LONGINT(@Date);
  254.    InfoArray[3] := LONGINT(@Time);
  255.  
  256. (*   AttrStr := '----';
  257.    IF Search.Attr AND Archive  = Archive  THEN AttrStr[1] := 'a';
  258.    IF Search.Attr AND Hidden   = Hidden   THEN AttrStr[2] := 'h';
  259.    IF Search.Attr AND SysFile  = SysFile  THEN AttrStr[3] := 's';
  260.    IF Search.Attr AND ReadOnly = ReadOnly THEN AttrStr[4] := 'o'
  261.                                           ELSE AttrStr[4] := 'w';
  262.    InfoArray[4] := LONGINT(@AttrStr);
  263.    InfoArray[5] := LONGINT(@Desc); *)
  264.  
  265. (*   FormatStr(s,'+ %-12s   %8s '+DateTempl+' '+TimeTempl+' %4s %-s',InfoArray); *)
  266.    FormatStr(s,'+ %-12s  %8s '+DateTempl+' '+TimeTempl,InfoArray);
  267.    WriteLn(Output,s); IF DoPage THEN TestForMoreMsg;
  268.  
  269.    INC(TotalSize,csize); INC(DirSize,csize);
  270.    INC(TotalFileCount);  INC(FileCount);
  271.   END;
  272. END; (* ShowFileData *)
  273.  
  274. END.